home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 18 / CU Amiga Magazine's Super CD-ROM 18 (1997)(EMAP Images)(GB)[!][issue 1998-01].iso / CUCD / Programming / ARexxGuide / ARx_RarpInfoWin.rexx < prev    next >
OS/2 REXX Batch file  |  1994-04-02  |  11KB  |  316 lines
  1. /* $VER: ARx_RArpInfoWin.rexx v 2.0                                    **
  2. **    Opens a rexxarplib window that displays information about the    **
  3. **    ARexx statement on the current line of an editor. Called as      **
  4. **    external function by ARx_Help.#?.                                **
  5. ** Arguments:                                                          **
  6. **        HLine    := The full line on which cursor is located             **
  7. **        LkUp     := The word on which cursor is located                  **
  8. **        CurPos   := Cursor x position within HLine                       **
  9. **        Kwd      := The first word in HLine                              **
  10. **    PoC      := Port to which button commands will be sent           **
  11. **        ExecStr  := The string that's sent by rexxarplib button press    **
  12. **        WInfo    := Position and screen name of editor window            */
  13.  
  14. parse arg HLine, LkUp, CurPos, Kwd, PoC,ExecStr, WInfo
  15.     /* They should still be on list, but just in case...                */
  16. call addlib('rexxsupport.library', 0, -30, 0)
  17. call addlib('rexxarplib.library', 0, -30, 0)
  18. call addlib('amigaguide.library', -2, -30, 0)
  19.  
  20. if word(ExecStr, 1) = 'QUOTE' then do
  21.     QuoteCmd = 1
  22.     ExecStr = subword(ExecStr, 2)
  23. end
  24. else
  25.     QuoteCmd = 0
  26.    /* figure out what type of clause the current line is */
  27. select
  28.         /* Is it an assignment? Check later on for valid var */
  29.     when word(HLine, 2) = '=' then
  30.         CType = 2
  31.         /* Is it a comment?    */
  32.    when pos('/*', HLine) < CurPos & pos('/*', HLine) ~= 0 then
  33.       if pos('*/', HLine) > CurPos | pos('*/', HLine) = 0 then
  34.          CType = 4
  35.       /* Is it an instruction? */
  36.    when getxref(word(HLine,1)) ~= 10 then do
  37.       Xref = getxref(word(HLine,1))
  38.       if word(Xref,3) = 2 then
  39.          CType = 1
  40.    end
  41.        /* Is it a label?      */
  42.    when right(word(HLine,1), 1) = ':' then
  43.       CType = 3
  44.       /* Is it null?         */
  45.    when HLine = '' then
  46.       CType = 5
  47.       /* Then it must be a command or assignment without spaces. */
  48.    otherwise
  49.       CType = 0
  50.           /* Is it an assignment instead of a command? */
  51.       EqPos = pos('=', HLine)
  52.       if EqPos > 0 then do
  53.               /* Add spaces for later checks        */
  54.          if symbol(strip(left(HLine, EqPos-1))) ~= 'BAD' then do
  55.             HLine=insert(' ', HLine, EqPos - 1)
  56.             HLine = insert(' ', HLine, EqPos + 2)
  57.             CType = 2
  58.             if CurPos > EqPos then CurPos = CurPos + 2
  59.          end
  60.       end
  61. end
  62. if CType = 2 then
  63.    if ~IsVar(word(HLine, 1)) then
  64.       CType = 0
  65.  
  66. /* Prepare window gadgets to explain the clause. */
  67. CName.0 = 'Command'
  68. CName.1 = 'Instruction'
  69. CName.2 = 'Assignment'
  70. CName.3 = 'Label'
  71. CName.4 = 'Comment'
  72. CName.5 = 'Null'
  73. Gad. = ''
  74. Gad.1.6Txt = 'Current clause is'
  75. Gad.1.6Btn = CName.CType
  76. Gad.1.6Cmd = ExecStr CName.CType
  77. Gadgets = 1
  78. select
  79.    when CType = 1 then do
  80.       Gad.2.6Txt = 'Current keyword is'
  81.       Gad.2.6Btn = Kwd
  82.       Gad.2.6Cmd = ExecStr Kwd
  83.       Gadgets = 2
  84.    end
  85.    when CType = 3 then do
  86.       Gad.2.6Txt = 'Name of subroutine:' word(HLine,1)'.'
  87.       Gadgets = 2
  88.    end
  89.        /* happens when cursor is at the end of a comment */
  90.    when ~datatype(CType, 'N') then
  91.        Gadgets = 0
  92.    otherwise
  93. end
  94.  
  95.       /* Figure out what the current word is doing */
  96.       /* Use variables to make the bit settings more obvious */
  97. FuncName = 0; Arg = 1; Str = 2; Var = 3; Num=4; Hex=5; Bin=6; Cnst=7; Cmpd = 8
  98. if CType <= 3 & LkUp > '' then do
  99.       /* Split the string so we can compare both sides */
  100.    parse var HLine LStr =CurPos RStr
  101.       /* Get only the portion of the string which contains LkUp */
  102.    WdRange = substr(HLine, max(1, CurPos - length(LkUp)), length(LkUp) *2)
  103.  
  104.       /* Use Bit functions to keep multiple matches */
  105.    WType = null()||null() /* Using more than 8 bytes */
  106.       /* Is it a string in single quotes ? */
  107.    if IsVar(LkUp) then do
  108.       WType = bitset(WType, Var)
  109.       if Kwd = 'CALL' then
  110.           if abbrev(word(HLine, 2), LkUp) then
  111.               WType = bitset(WType, FuncName)
  112.           else
  113.               WType = bitset(Wtype, Arg)
  114.    end
  115.    if verify(HLine, '"''', M) > 0 then do
  116.       if CountChar(LStr, "'")//2 then do
  117.          WType = bitset(WType, Str)
  118.             /* Is it a quoted function name? */
  119.          if pos(LkUp"'(", WdRange) & bittst(WType, Var) then
  120.                WType = bitset(WType, FuncName)
  121.          else if datatype(LkUp, X) then
  122.             if pos(upper(LkUp)"'X", upper(HLine)) > 0 then
  123.                WType = bitset(WType, Hex)
  124.          else if datatype(LkUp, B) then
  125.             if pos(upper(LkUp)"'B", upper(WdRange)) > 0 then
  126.                WType = bitset(WType, Bin)
  127.       end
  128.          /* Is it a string in double quotes? */
  129.       else if CountChar(LStr, '"')//2 then do
  130.          WType = bitset(WType, Str)
  131.          if pos(LkUp'"(', WdRange) & bittst(WType, Var) then
  132.                WType = bitset(WType, FuncName)
  133.          else if datatype(LkUp, X) then
  134.             if pos(upper(LkUp)'"X', upper(HLine)) then
  135.                WType = bitset(WType, Hex)
  136.          else if datatype(LkUp, B) then
  137.             if pos(upper(LkUp)'"B', upper(WdRange)) > 0 then
  138.                WType = bitset(WType, Bin)
  139.       end
  140.           /* If it's a string, it isn't a variable          */
  141.       if bittst(WType, Str) then
  142.          WType = bitclr(WType, Var)
  143.    end
  144.       /* Is current word enclosed in parens? */
  145.    if verify(HLine, "()", M) > 0 then do
  146.       if CountChar(LStr, "(") - CountChar(LStr, ")") > 0 then
  147.             WType = bitset(WType, Arg)
  148.       if pos(LkUp'(', WdRange) > 0 & bittst(WType, Var) then
  149.             WType = bitset(WType, FuncName)
  150.    end
  151.  
  152.       /* is it a number or constant? */
  153.    if datatype(LkUp, N) then do
  154.          /* Make sure it isn't already a hex or bin string */
  155.       if ~bittst(WType, Hex) & ~bittst(WType, Bin) then
  156.             WType = bitset(WType, Num)
  157.    end
  158.       /* compare String/Var. If it isn't one of those it's a constant */
  159.    else if ~bittst(WType, Var) then do
  160.       if ~bittst(WType, Str) then
  161.          WType = bitset(WType, Cnst)
  162.    end
  163.    else if pos('.', LkUp) > 0 then
  164.        WType = bitset(WType, Cmpd)
  165.       /* it could have been assigned FuncName in either check above **
  166.       ** In either case, a Function name isn't a variable           */
  167.    if bittst(WType, FuncName) then
  168.       WType = bitclr(WType, Var)
  169.    if CType = 3 then
  170.        if abbrev(Kwd, upper(LkUp)) then
  171.            WType = null()
  172.  
  173.         /* Now take out the string def from hex/bin numbers           */
  174.     if verify(bitcomp(WType, bitand(d2c(hex), d2c(bin))), Hex Bin) = 0 then
  175.         WType = bitclr(WType, Str)
  176.       /** Prepare gadgets to explain current word **/
  177.    if WType ~= null() then do
  178.       interpret 'Gad.'Gadgets+1'.6Txt = ''"''Lkup''" is'''
  179.       if bittst(WType, FuncName) then do
  180.          Gadgets = Gadgets + 1
  181.          Gad.Gadgets.6Btn = 'Function name'
  182.          Gad.Gadgets.6Cmd = ExecStr 'FUNCTION'
  183.       end
  184.       if bittst(WType, Arg) then do
  185.          Gadgets = Gadgets + 1
  186.          Gad.Gadgets.6Btn = 'Function argument'
  187.          Gad.Gadgets.6Cmd = ExecStr 'FUNCARG'
  188.       end
  189.       if bittst(WType, Str) then do
  190.          Gadgets = Gadgets + 1
  191.          Gad.Gadgets.6Btn = 'String'
  192.          Gad.Gadgets.6Cmd = ExecStr 'STRINGEXPR'
  193.       end
  194.       if bittst(WType, Hex) then do
  195.          Gadgets = Gadgets + 1
  196.          Gad.Gadgets.6Btn = 'Hex string'
  197.          Gad.Gadgets.6Cmd = ExecStr 'HEXSTRING'
  198.       end
  199.       if bittst(WType, Bin) then do
  200.          Gadgets = Gadgets + 1
  201.          Gad.Gadgets.6Btn = 'Binary string'
  202.          Gad.Gadgets.6Cmd = ExecStr 'HEXSTRING'
  203.       end
  204.       if bittst(WType, Var) then do
  205.          Gadgets = Gadgets + 1
  206.          Gad.Gadgets.6Btn = 'Variable'
  207.          Gad.Gadgets.6Cmd = ExecStr 'VARIABLE'
  208.       end
  209.       if bittst(WType, Cmpd) then do
  210.          Gadgets = Gadgets + 1
  211.          Gad.Gadgets.6Btn= 'Compound variable'
  212.          Gad.Gadgets.6Cmd = ExecStr 'COMPVAR'
  213.       end
  214.       if bittst(WType, Num) then do
  215.          Gadgets = Gadgets + 1
  216.          Gad.Gadgets.6Btn = 'Number'
  217.          Gad.Gadgets.6Cmd = ExecStr 'NUMBER'
  218.       end
  219.       if bittst(WType, Cnst) then do
  220.          Gadgets = Gadgets + 1
  221.          Gad.Gadgets.6Btn = 'Constant symbol'
  222.          Gad.Gadgets.6Cmd = ExecStr 'CONSTANT'
  223.       end
  224.    end
  225. end
  226.    /* Open the rexxarplib requester window */
  227. CPort = 'ARX_ARP'
  228. if ~InfoWin(CPort, Gadgets+2, 'Lookup:' LkUp, PoC, word(WInfo, 1), word(WInfo, 2), word(Winfo, 3)) then return 10
  229.  
  230.  
  231. if PoC = 'ARX_HELP' then
  232.     CloseCmd = 'address' CPort '"QUIT";Status = CLOSE'
  233. else if abbrev(PoC, 'TURBO') then
  234.     CloseCmd = 'ExecARexxString address' CPort '"QUIT"'
  235. else
  236.     CloseCmd = 'address' CPort '"QUIT"'
  237.  
  238.     /* Draw the gadgets into the window     */
  239. x = 10; y = 32
  240. do i = 1 to Gadgets
  241.    call move(CPort, x, y)
  242.    if Gad.i.6Btn = '' then
  243.       Txt = center(Gad.i.6Txt,47)
  244.    else
  245.       Txt = right(Gad.i.6Txt, 21)
  246.    call Text(CPort, Txt)
  247.    if Gad.i.6Btn > '' then do
  248.         if QuoteCmd then
  249.             Gad.i.6Cmd = '"'Gad.i.6Cmd'"'
  250.       call AddGadget(CPort, 192, y - 9, i, ' 'left(Gad.i.6Btn, 26),Gad.i.6Cmd)
  251.    end
  252.    y = y + 15
  253. end
  254.     /* Can't open onto the index contents because that is in main */
  255. if QuoteCmd then
  256.     IdxCmd = '"'ExecStr 'ARx_NdxCont"'
  257. else
  258.     IdxCmd = ExecStr 'ARx_NdxCont'
  259. call AddGadget(CPort, 10, y-4, 14, ' View ARexxGuide index ',IdxCmd)
  260. call AddGadget(CPort, 344, y-4, 15, ' Cancel ', CloseCmd)
  261.  
  262. /* Since some editors can't receive commands to be sent on to AmigaGuide **
  263. ** this port can be used to receive command from the button window. It's **
  264. ** opened if the address established by the SETADDRESS function in the   **
  265. ** editor macro is set to 'ARX_HELP'                                     */
  266. if PoC = 'ARX_HELP' then do
  267.    PortAddr = openport(Poc)
  268.       /* Loop until a Cmd changes the value of [Status] */
  269.    do until Status = 'CLOSE'
  270.       call waitpkt(PoC)
  271.       Packet = getpkt(PoC)
  272.          /* Make sure we have a real message in [Packet] */
  273.       if Packet ~= null() then do
  274.          Cmd = strip(getarg(Packet),,'"')
  275.          interpret Cmd
  276.          call reply(Packet, 0)
  277.          status = 'CLOSE'    /* It was a good command, so get out */
  278.       end
  279.    end
  280.    call closeport PortAddr
  281. end
  282.  
  283. return 0
  284.  
  285.  
  286. InfoWin: procedure
  287.    parse arg CPort, Rows, WinTitle, PoC, x, y, PubScr
  288.  
  289.       /** shut down previous requester if it's still around **/
  290.    if show(P, CPort) then do; address value CPort; quit; address; end
  291.       /* change notifyport (PoC) to a port read by this script */
  292.    address ARexx "'call CreateHost("CPort"," PoC", "PubScr")'"
  293.       /**   Open the window   **/
  294.    idcmp = 'CLOSEWINDOW+GADGETUP'
  295.    flags = 'WINDOWCLOSE+WINDOWDRAG+WINDOWDEPTH+ACTIVATE'
  296.    address command 'waitforport' CPort
  297.    Height = 16+15*Rows
  298.    if rc = 0 then do
  299.       call OpenWindow(CPort, x, y, 422, Height, idcmp,flags, WinTitle)
  300.       call SetAPen(CPort, 2)
  301.       call SetNotify(CPort, CLOSEWINDOW, CPort)
  302.       return 1
  303.     end
  304.    else
  305.       return 0
  306.  
  307.  
  308. CountChar:
  309. call trace b
  310. return length(arg(1)) - length(compress(arg(1), arg(2)))
  311.  
  312. IsVar:
  313.    call trace b
  314.    return symbol(arg(1)) ~== 'BAD' & (datatype(left(arg(1),1), m),
  315.                                      | verify(left(arg(1),1), '!$_@#', M))
  316.